home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / powerlogo-1.4 / utilities / math < prev    next >
Encoding:
Text File  |  1996-07-16  |  4.8 KB  |  178 lines
  1.  
  2. ; *********************************************************************
  3. ;     Math Utilities
  4. ; *********************************************************************
  5.  
  6.  
  7. ; *********************************************************************
  8. ;  3-D vector arithmatic. Where a vector is a list of three numbers,
  9. ;                         and a basis is a list of three 3-D vectors.
  10.  
  11. make "-v [
  12.    procedure [ [ :a ] ]
  13.    output vscale :a -1 ]
  14.  
  15. make "vadd [
  16.    procedure [ [ :a :b ] ]
  17.    output ( list  + first :a first :b
  18.                   + item 2 :a item 2 :b
  19.                   + item 3 :a item 3 :b ) ]
  20.  
  21. make "vsub [
  22.    procedure [ [ :a :b ] ]
  23.    output ( list  - first :a first :b
  24.                   - item 2 :a item 2 :b
  25.                   - item 3 :a item 3 :b ) ]
  26.  
  27. make "vscale [
  28.    procedure [ [ :v :s ] ]
  29.    output ( list  * first :v :s
  30.                   * item 2 :v :s
  31.                   * item 3 :v :s ) ]
  32.  
  33. make "vdot [
  34.    procedure [ [ :a :b ] ]
  35.    output ( +  * first :a first :b
  36.                * item 2 :a item 2 :b
  37.                * item 3 :a item 3 :b ) ]
  38.  
  39. make "vcross [
  40.    procedure [ [ :a :b ] ]
  41.    output ( list  -  * item 2 :a item 3 :b
  42.                      * item 3 :a item 2 :b
  43.                   -  * item 3 :a item 1 :b
  44.                      * item 1 :a item 3 :b
  45.                   -  * item 1 :a item 2 :b
  46.                      * item 2 :a item 1 :b ) ]
  47.  
  48. make "vmag [
  49.    procedure [ [ :v ] ]
  50.    output sqrt vdot :v :v ]
  51.  
  52. make "vrotate [
  53.    procedure [ [ :v :pv :a ] ] 
  54.    output vadd vscale :v cos :a vscale :pv sin :a ]
  55.  
  56. make "vbasis [
  57.    procedure [ [ :vector :basis ] ]
  58.    output ( list  vdot :vector item 1 :basis
  59.                   vdot :vector item 2 :basis
  60.                   vdot :vector item 3 :basis ) ]
  61.  
  62. make "rotate-xy [
  63.    procedure [ [ :basis :angle ] ]
  64.    output ( list  vrotate item 1 :basis item 2 :basis :angle
  65.                   vrotate item 2 :basis -v item 1 :basis :angle
  66.                   item 3 :basis ) ]
  67.  
  68. make "rotate-yz [
  69.    procedure [ [ :basis :angle ] ]
  70.    output ( list  item 1 :basis
  71.                   vrotate item 2 :basis item 3 :basis :angle
  72.                   vrotate item 3 :basis -v item 2 :basis :angle ) ]
  73.  
  74. make "rotate-zx [
  75.    procedure [ [ :basis :angle ] ]
  76.    output ( list  vrotate item 1 :basis -v item 3 :basis :angle
  77.                   item 2 :basis
  78.                   vrotate item 3 :basis item 1 :basis :angle ) ]
  79.  
  80.  
  81. ; *********************************************************************
  82. ;  Complex Numbers. Where a complex number is a list of two numbers.
  83.  
  84. make "cadd [
  85.    procedure [ [ :a :b ] ]
  86.    output   list  + first :a first :b
  87.                   + item 2 :a item 2 :b ]
  88.  
  89. make "csub [
  90.    procedure [ [ :a :b ] ]
  91.    output   list  - first :a first :b
  92.                   - item 2 :a item 2 :b ]
  93.  
  94. make "cmult [
  95.    procedure [ [ :a :b ] ]
  96.    output   list  -  * first :a first :b
  97.                      * item 2 :a item 2 :b
  98.                   +  * item 2 :a first :b
  99.                      * first :a item 2 :b ]
  100.  
  101. make "cdiv [
  102.    procedure [ [ :a :b ] [ ] [ :num :den :con ] ]
  103.    make "con conjg :b
  104.    make "den first cmult :b :con
  105.    make "num cmult :a :con
  106.    output list / first :num :den
  107.                / item 2 :num :den ]
  108.  
  109. make "cconj [
  110.    procedure [ [ :a ] ]
  111.    output   list  first :a
  112.                   +- item 2 :a ]
  113.  
  114. make "cabs [
  115.    procedure [ [ :a ] ]
  116.    output sqrt + * first :a first :a * item 2 :a item 2 :a ]
  117.  
  118. make "csqrt [
  119.    procedure [ [ :a ] [ ] [ :x :y :w :r ] ]
  120.    make "x abs first :a
  121.    make "y abs item 2 :a
  122.    if ( =0 :x :y )
  123.    [  output [ 0 0 ] ]
  124.    [  if >= :x :y
  125.       [  make "r / :y :x
  126.          make "w * sqrt :x sqrt * 0.5 + 1 sqrt + 1 * :r :r ]
  127.       [  make "r / :x :y
  128.          make "w * sqrt :y sqrt * 0.5 + :r sqrt + 1 * :r :r ]
  129.       output if >= first :a 0
  130.       [  list :w / item 2 :a * 2 :w ]
  131.       [  make "r if >= item 2 :a 0 [ :w ] [ +- :w ]
  132.          list  :r
  133.                / item 2 :a * 2 :r ] ] ]
  134.  
  135. make "cscale [
  136.    procedure [ [ :a :b ] ]
  137.    output   list  * first :a :b
  138.                   * item 2 :a :b ]
  139.  
  140.  
  141. ; *********************************************************************
  142.  
  143. ; FACTORIAL ************************************************************
  144. ;    Factorial function.
  145. ;  ! num
  146.  
  147. make "! [
  148.   procedure [ [ :n ] ]
  149.   op if <= :n 1  [ 1 ]  [ * :n ! - :n 1 ] ]
  150.  
  151.  
  152. ; GCD ******************************************************************
  153. ;    Greatest common divisor of two numbers.
  154. ;  gcd n1 n2
  155.  
  156. make "gcd [
  157.   procedure [ [ :a :b ] ]
  158.   if =0 :b  [ op :a ]  [ op gcd :b remainder :a :b ] ]
  159.  
  160.  
  161. ; LCM ******************************************************************
  162. ;    Least common multiple of two numbers.
  163. ;  lcm n1 n2
  164.  
  165. make "lcm [
  166.   procedure [ [ :a :b ] ]
  167.   op * / :a gcd :a :b :b ]
  168.  
  169.  
  170. ; Useful numerical constants *******************************************
  171.  
  172. make "e  2.71828182845904523536
  173. make "pi 3.14159265358979323846
  174. make "phi / + 1 sqrt 5 2        ; golden ratio
  175.  
  176.  
  177.  
  178.